Optional GL-tools.f

{
This library provides convenience words for OpenGL programming.
}

Requires OpenGL
Requires OpenGL\ARB-VBO
Requires FixedPoint
Requires KAGI
Requires SEKI

Only Forth Definitions

variable last-matrix
variable gl-blend GL_BLEND ,
variable gl-alpha GL_ALPHA ,
variable gl-alphatest GL_ALPHA_TEST ,
variable gl-depthtest GL_DEPTH_TEST ,
variable last-depthfunc
variable last-depthmask
variable last-alphafunc
variable last-blendfunc
variable last-texture
variable gl-texture GL_TEXTURE_2D ,
variable gl-vertex-array GL_VERTEX_ARRAY ,
variable gl-texture-array GL_TEXTURE_COORD_ARRAY ,
variable gl-color-array GL_COLOR_ARRAY ,
variable gl-normal-array GL_NORMAL_ARRAY ,
variable last-vbo
0 value texture-filter \ defines the filtering to use for new textures ( GL_NEAREST, GL_LINEAR )
   GL_NEAREST to texture-filter



GL_PROJECTION constant projection
GL_MODELVIEW constant modelview
GL_TEXTURE constant texture-matrix

0 value 2dmode?

: matrix   last-matrix <>:[ glMatrixMode ;] ;
: identity   glLoadIdentity ;
: pm-identity    projection matrix identity ;
: mv-identity   modelview matrix identity ( 2dmode? if 0.001e 0.001e 0e  glTranslatef  then ) ;
: tm-identity    texture-matrix matrix identity ;

: push-modelview   modelview matrix glPushMatrix ;
: pop-modelview   modelview matrix glPopMatrix ;
: push-texmtx   texture-matrix matrix glPushMatrix ;
: pop-texmtx  texture-matrix matrix glPopMatrix ;

: gl-enable   dup cell+ @ locals| flag | GL_TRUE swap <>:[ drop glEnable( flag ) ;] ;
: gl-disable   dup cell+ @ locals| flag | GL_FALSE swap <>:[ drop glDisable( flag ) ;] ;
: gl-enable-clientstate
   dup cell+ @ locals| flag | GL_TRUE swap <>:[ drop glEnableClientState( flag ) ;] ;
: gl-disable-clientstate
   dup cell+ @ locals| flag | GL_FALSE swap <>:[ drop glDisableClientState( flag ) ;] ;

: enable-translucency
  gl-alpha gl-enable
  gl-blend gl-enable ;

: disable-translucency
  gl-alpha gl-disable
  gl-blend gl-disable ;

: set-blendfunc   ( n -- ) last-blendfunc <>:[ execute glBlendFunc ;] ;
: set-alphafunc  ( xt -- ) last-alphafunc <>:[ execute glAlphaFunc ;] ;
: set-depthfunc   ( n -- ) last-depthfunc <>:[ glDepthFunc ;] ;

: bind-texture
   gl-texture gl-enable
   last-texture <>:[ GL_TEXTURE_2D swap glBindTexture ;] ;


: disable-depth-writing
  glDepthMask( GL_FALSE )  ;

: enable-depth-writing
  glDepthMask( GL_TRUE )  ;
{

: disable-depth-occlusion
  glDepthFunc( GL_ALWAYS ) ;
}

: new-vbo ( -- n )
  glGenBuffersARB( 1   pad  )   pad @ ;

: bind-vbo  ( vbo -- )
   last-vbo <>:[ glBindBufferARB( GL_ARRAY_BUFFER_ARB swap ) ;] ;

: unbind-vbo  ( -- )
   0 bind-vbo ;

: unmap-vbo ( -- )
   begin glUnmapBufferARB( GL_ARRAY_BUFFER_ARB ) until ;

: map-vbo ( size vbo -- addr )
   bind-vbo
   glBufferDataARB( GL_ARRAY_BUFFER_ARB swap   0   GL_STREAM_DRAW_ARB )
   glMapBufferARB( GL_ARRAY_BUFFER_ARB GL_WRITE_ONLY_ARB )  ;

: cls
   GL_COLOR_BUFFER_BIT GL_STENCIL_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT OR glClear ;

variable bgc
: clear-color
   bgc !
   glClearColor( bgc c@+ c>f c@+ c>f c@ c>f 1e ) ;

create tx 0 ,
: texture!filter
   glTexParameteri( GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER third )
   glTexParameteri( GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER rot ) ;

: new-texture ( -- texture )
   glGenTextures( 1  tx )
   tx @ dup bind-texture
   texture-filter texture!filter ;

: free-texture ( texture -- )
   tx !
   glDeleteTextures( 1  tx ) ;

: alphafunc[>0]   GL_GREATER 0e ;

:[] blendfunc:[  execute glBlendFunc ;
: set-default-blendfunc   blendfunc:[ GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA ;] ;
: set-default-alphafunc   ['] alphafunc[>0] set-alphafunc ;
: set-default-depthfunc   GL_LEQUAL set-depthfunc ;

: reset-gl
   cr ." Reseting GL..."
   last-matrix off
   gl-blend off        gl-blend gl-enable
   gl-alpha off        gl-alpha gl-enable
   gl-alphatest off    gl-alphatest gl-enable
   gl-depthtest on    gl-depthtest gl-disable
   last-depthfunc off  set-default-depthfunc
   last-alphafunc off  set-default-alphafunc
   last-blendfunc off  set-default-blendfunc
   last-texture on     0 bind-texture
   gl-texture on       gl-texture gl-disable
   last-vbo on         unbind-vbo
   glClearDepth( 1e )
   cls
   pm-identity
   tm-identity
   mv-identity
   glDepthFunc( GL_LEQUAL )
   glEnable( GL_DEPTH_TEST ) ;
